{%mainunit bitcoin_p2p.pas}

{$IFDEF INTERFACE}
type
  { TPeer represents a connected peer. Its anchestor TPeerAbstract
    with a few abstract methods is declared in the unit bitcoin_p2p_messages
    because the message classes need an interface to TPeer to know how to
    call the TPeer.OnXxxx() methods after they are done parsing a message.
    TPeerAbstract itself is derived from a TThread }
  TPeer = class(TThread)
    constructor Create(PeerAddrV4: String; PeerPort: Word);
    destructor Destroy; override;

  protected
    procedure Execute; override;

  strict protected
    FVersion     : DWord;
    FCanFree     : Boolean;
    FConn        : TLTcp;
    FPeerAddress : String;

    // callbacks called by lNet
    procedure OnDisconnect(ASocket: TLSocket);
    procedure OnReceive(ASocket: TLSocket);
    procedure OnConnect(ASocket: TLSocket);
    procedure OnError(const msg: string; aSocket: TLSocket);

  public
    // these methods are called from the message objects
    procedure OnVersion(Msg: TMsgVersion);

    property Version: DWord read FVersion;
    property CanFree: Boolean read FCanFree;
    property PeerAddress: String read FPeerAddress;
  end;

{$ENDIF}
{$IFDEF IMPLEMENTATION}

{ TPeer }

constructor TPeer.Create(PeerAddrV4: String; PeerPort: Word);
begin
  inherited Create(true);
  FVersion := 0;
  FCanFree := False;
  FPeerAddress := PeerAddrV4;

  FConn := TLTcp.Create(nil);
  FConn.OnDisconnect := @OnDisconnect;
  FConn.OnReceive := @OnReceive;
  FConn.OnError := @OnError;
  FConn.OnConnect := @OnConnect;

  log('trying %s:%d', [PeerAddrV4, PeerPort]);
  FConn.Connect(PeerAddrV4, PeerPort);
end;

destructor TPeer.Destroy;
begin
  FConn.Free;
  inherited Destroy;
end;

procedure TPeer.Execute;
var
  TimeoutCounter : Integer = 3; // ~seconds
begin
  FConn.Timeout := 950 + Random(100);
  repeat
    if (not FConn.Connected) and (TimeoutCounter = 0) then begin
      log('conection timeout (%s)', [PeerAddress]);
      FConn.Disconnect(True);
      Terminate;
    end else begin
      Dec(TimeoutCounter);
    end;
    try
      FConn.CallAction;
    except
      // this is not supposed to happen. No exception should
      // propagate up to this point. This must be a bug!
      LogException('BUG: during CallAction()');
    end;
    {$ifdef HEAPTRC}DumpHeap;{$endif}
  until Terminated;
  log('peer thread terminated (%s)', [PeerAddress]);
  FCanFree := True;
end;

procedure TPeer.OnDisconnect(ASocket: TLSocket);
begin
  Log('disconnected (%s)', [PeerAddress]);
  Dec(TotalConections);
  Terminate;
end;

procedure TPeer.OnReceive(ASocket: TLSocket);
var
  Header     : TP2PHeader;
  Buffer     : PByte = nil;
  DataStream : TStringStream = nil;
  Msg        : TMsg = nil;
begin
  if ReadHeaderFromSocket(ASocket, Header) = False then exit;
  Log('received: %s (%d bytes)', [Header.Command, Header.Length]);

  if Header.Length = 0 then begin
     // this is most likely the verack message,
     // no data to read, no further action needed.
    exit;
  end;

  try
    DataStream := TStringStream.Create('');
    Buffer := GetMem(Header.Length);
    if ReadBlocking(ASocket, Buffer^, Header.Length) then begin

      if (PChar(Header.Command) = 'version') // ugly wart in the protocol
      or (DWord(CheckSum(Buffer^, Header.Length)) = DWord(Header.CheckSum)) then begin

        // My message classes will only eat TStringStream, not stumble around
        // in buffers with pointers. So If you are looking for possible buffer
        // overflows in the parser then you can stop reading at this point ;-)
        DataStream.Write(Buffer^, Header.Length);
        DataStream.Seek(0, soBeginning);
        Msg := TMsg.GetIncomingInstance(Self, Header.Command, DataStream);
        if Msg <> nil then begin
          try
            Msg.ParseAndProcess;
          except
            LogException('error while parsing incoming message %s', [Header.Command]);
          end;
        end; // else: this message is not (yet) implemented
      end else
        Log('incoming message checksum wrong');
    end else
      Log('socket died while reading message');
  finally
    if Buffer <> nil then Freemem(Buffer);
    if DataStream <> nil then DataStream.Free;
    if Msg <> nil then Msg.Free;
  end;
end;

procedure TPeer.OnConnect(ASocket: TLSocket);
var
  TmpAddrMe,
  TmpAddrYou : TNetAddress;
  Msg        : TMsgVersion;
begin
  Inc(TotalConections);
  Log('connected to %s:%d', [ASocket.PeerAddress, ASocket.PeerPort]);
  log('*** have now %d connections', [TotalConections]);
  ASocket.SetState(ssBlocking, True);

  { These two objects will be owned by the version message object
    which will free them in its destructor, so we dont free them here }
  TmpAddrMe := TNetAddress.Create(0, '0.0.0.0', 0);
  TmpAddrYou := TNetAddress.Create(1, ASocket.PeerAddress, ASocket.PeerPort);

  Msg := TMsgVersion.Create(TmpAddrMe, TmpAddrYou, 0);
  FConn.SendMessage(Msg.Serialize, ASocket);
  Msg.Free;
end;

procedure TPeer.OnError(const msg: string; aSocket: TLSocket);
begin
  Log('%s (%s)', [msg, PeerAddress]);
  FConn.Disconnect(True);
  Terminate;
end;


procedure TPeer.OnVersion(Msg: TMsgVersion);
var
  Answer : TMsgVerack;
begin
  FVersion := Msg.Version;
  Answer := TMsgVerack.Create;
  FConn.SendMessage(Answer.Serialize);
  Answer.Free;
end;

{$ENDIF}
